home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_c / api_shar / shareb.pas < prev   
Pascal/Delphi Source File  |  1989-01-26  |  4KB  |  173 lines
  1. (****************************************************************
  2. *
  3. *  Name:          SHAREB
  4. *
  5. *  Function:      share memory/data among multiple processes
  6. *
  7. *  Shows how to:  1. read from and write to shared memory.
  8. *                 2. receive from another process the address of shared data.
  9. *                 3. control access to shared data via mailbox semaphore.
  10. *
  11. *  Written by:    Larry Rush, Quarterdeck Office Systems
  12. *
  13. *  Contact:       Voice:  (213) 392-9851, (213) 392-9701
  14. *                 BBS:    (213) 396-3904, (213) 392-2278
  15. *                 Fax:    (213) 399-3802
  16. *
  17. ****************************************************************)
  18.  
  19. program ShareB;
  20.  
  21. uses DVAPI;
  22.  
  23. const
  24.  
  25.   (* minimum API version required *)
  26.   REQUIRED = $200;
  27.  
  28.   (* arbitrary # times to read/write shared memory *)
  29.   REPS = 4;
  30.  
  31. var
  32.  
  33.   (* API version number *)
  34.   version : integer;
  35.  
  36.   (* TFDD text file *)
  37.   tfd : text;
  38.  
  39.   (* application handle of other process *)
  40.   apphana : ULONG;
  41.  
  42.   (* mail-related variables *)
  43.   status : integer;
  44.   malptr : pointer;
  45.   mallng : integer;
  46.  
  47.   (* read/write loop control variable *)
  48.   i : integer;
  49.  
  50. type
  51.  
  52.   (* type declarations related to shared data *)
  53.   (*i* DATATYPE = integer; *i*)
  54.   DATATYPE = string[10];
  55.   DATAPTR = ^DATATYPE;
  56.   (*r* DATATYPE = record *r*)
  57.     (*r* link : DATAPTR; *r*)
  58.     (*r* lng : integer; *r*)
  59.     (*r* data : string[10]; *r*)
  60.   (*r* end; *r*)
  61.  
  62. const
  63.  
  64.   (* constant value to be assigned to shared memory *)
  65.   (*i* SHRCONST : DATATYPE = 22222; *i*)
  66.   SHRCONST : DATATYPE = '     BBBBB';
  67.   (*r* SHRCONST : DATATYPE = ( *r*)
  68.     (*r* link : Nil; *r*)
  69.     (*r* lng : 22222; *r*)
  70.     (*r* data : '     BBBBB' *r*)
  71.   (*r* ); *r*)
  72.  
  73. var
  74.  
  75.   (* pointer to shared data *)
  76.   bufptr : DATAPTR;
  77.  
  78.   (* pointer to pointer to shared data *)
  79.   bufptrptr : ^DATAPTR;
  80.  
  81.   (* mailbox semaphore controlling access to shared memory *)
  82.   sema : ULONG;
  83.  
  84. const
  85.  
  86.   (* global name of mailbox semaphore *)
  87.   name : string = 'Shared Memory Semaphore';
  88.  
  89.  
  90. (********************************************************************
  91. *  program_body  -  read, display and modify contents of shared data.
  92. ********************************************************************)
  93.  
  94. procedure program_body;
  95. begin
  96.  
  97.   (* open TFDD *)
  98.   tfd_open (tfd,win_me);
  99.  
  100.   (* find named mailbox semaphore *)
  101.   sema := mal_sfind (name);
  102.  
  103.   (* read pointer to mailed data *)
  104.   status := mal_read (mal_me,malptr,mallng);
  105.  
  106.   (* assign read pointer to a variable which is a pointer to a pointer *)
  107.   bufptrptr := malptr;
  108.  
  109.   (* assign pointer to shared data by dereferencing pointer to pointer *)
  110.   bufptr := bufptrptr^;
  111.  
  112.   (* get the application task handle of other process *)
  113.   apphana := mal_addr (mal_me);
  114.  
  115.   (* loop till handle of other process is no longer valid *)
  116.   while (api_isobj (apphana)) do
  117.   begin
  118.  
  119.     (* lock semaphore *)
  120.     mal_lock (sema);
  121.  
  122.     (* loop REPS times *)
  123.     for i := 1 to REPS do
  124.     begin
  125.  
  126.       (* read & display current contents & address of shared data *)
  127.       (*i* writeln (tfd,bufptr^,' at ',seg (bufptr^),':',ofs (bufptr^)); *i*)
  128.       writeln (tfd,bufptr^,' at ',seg (bufptr^),':',ofs (bufptr^));
  129.       (*r* with bufptr^ do *r*)
  130.         (*r* writeln (tfd,lng,' ',data,' at ',seg (bufptr^),':',ofs (bufptr^)); *r*)
  131.  
  132.       (* modify contents of shared data *)
  133.       bufptr^ := SHRCONST;
  134.  
  135.     end;
  136.  
  137.     (* unlock semaphore *)
  138.     mal_unlock (sema);
  139.  
  140.   end;
  141.  
  142.   (* close TFDD *)
  143.   tfd_close (tfd);
  144.  
  145. end;
  146.  
  147.  
  148. (**********************************************************************
  149. *  main  -  check for DESQview present and enable required extensions.
  150. ***********************************************************************)
  151.  
  152. begin
  153.  
  154.   (* initialize Pascal interfaces and get API version number *)
  155.   version := api_init;
  156.  
  157.   (* if DESQview is not running or version is too low, display a message *)
  158.   if (version < REQUIRED) then
  159.     writeln ('This program requires DESQview version ',REQUIRED div 256,
  160.        '.',(REQUIRED mod 256) div 16,(REQUIRED mod 256) mod 16,' or later.')
  161.  
  162.   (* tell DESQview what extensions to enable and start application *)
  163.   else
  164.   begin
  165.     api_level (REQUIRED);
  166.     program_body;
  167.   end;
  168.  
  169.   (* disable Pascal interfaces and return from program *)
  170.   api_exit;
  171.  
  172. end.
  173.